home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / [_Time_Syn1802171072004.psc / frmMain.frm < prev    next >
Text File  |  2004-09-02  |  9KB  |  309 lines
  1. VERSION 5.00
  2. Begin VB.Form frmMain 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   " Time Sync"
  5.    ClientHeight    =   3945
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   5595
  9.    Icon            =   "frmMain.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   3945
  14.    ScaleWidth      =   5595
  15.    StartUpPosition =   2  'CenterScreen
  16.    Begin VB.CommandButton cmdClose 
  17.       Caption         =   "&Close"
  18.       Height          =   375
  19.       Left            =   4320
  20.       TabIndex        =   1
  21.       Top             =   3480
  22.       Width           =   1215
  23.    End
  24.    Begin VB.Frame Frame2 
  25.       Height          =   30
  26.       Left            =   0
  27.       TabIndex        =   8
  28.       Top             =   3360
  29.       Width           =   5535
  30.    End
  31.    Begin VB.Frame Frame1 
  32.       BackColor       =   &H00FFFFFF&
  33.       BeginProperty Font 
  34.          Name            =   "Tahoma"
  35.          Size            =   8.25
  36.          Charset         =   0
  37.          Weight          =   400
  38.          Underline       =   0   'False
  39.          Italic          =   0   'False
  40.          Strikethrough   =   0   'False
  41.       EndProperty
  42.       Height          =   1095
  43.       Left            =   -120
  44.       TabIndex        =   3
  45.       Top             =   -120
  46.       Width           =   6015
  47.       Begin VB.Image Image1 
  48.          Height          =   780
  49.          Left            =   360
  50.          Picture         =   "frmMain.frx":0442
  51.          Top             =   240
  52.          Width           =   690
  53.       End
  54.       Begin VB.Label Label1 
  55.          BackStyle       =   0  'Transparent
  56.          Caption         =   "Time Server Synchronization"
  57.          BeginProperty Font 
  58.             Name            =   "MS Sans Serif"
  59.             Size            =   12
  60.             Charset         =   0
  61.             Weight          =   700
  62.             Underline       =   0   'False
  63.             Italic          =   0   'False
  64.             Strikethrough   =   0   'False
  65.          EndProperty
  66.          ForeColor       =   &H00000000&
  67.          Height          =   375
  68.          Left            =   1440
  69.          TabIndex        =   4
  70.          Top             =   480
  71.          Width           =   3855
  72.       End
  73.    End
  74.    Begin VB.Timer Timer1 
  75.       Interval        =   250
  76.       Left            =   120
  77.       Top             =   3480
  78.    End
  79.    Begin VB.ComboBox cboServers 
  80.       BackColor       =   &H00FFFFFF&
  81.       BeginProperty Font 
  82.          Name            =   "Tahoma"
  83.          Size            =   8.25
  84.          Charset         =   0
  85.          Weight          =   400
  86.          Underline       =   0   'False
  87.          Italic          =   0   'False
  88.          Strikethrough   =   0   'False
  89.       EndProperty
  90.       ForeColor       =   &H00000000&
  91.       Height          =   315
  92.       Left            =   120
  93.       Style           =   2  'Dropdown List
  94.       TabIndex        =   2
  95.       Top             =   2880
  96.       Width           =   2535
  97.    End
  98.    Begin VB.CommandButton cmdSynchTime 
  99.       Caption         =   "&Synchronize"
  100.       Height          =   375
  101.       Left            =   2640
  102.       TabIndex        =   0
  103.       Top             =   3480
  104.       Width           =   1575
  105.    End
  106.    Begin VB.Image imgWarn 
  107.       Height          =   275
  108.       Left            =   120
  109.       Picture         =   "frmMain.frx":20F4
  110.       Stretch         =   -1  'True
  111.       Top             =   2225
  112.       Visible         =   0   'False
  113.       Width           =   275
  114.    End
  115.    Begin VB.Label Label4 
  116.       BackStyle       =   0  'Transparent
  117.       Caption         =   "Computer System Time"
  118.       ForeColor       =   &H00000000&
  119.       Height          =   255
  120.       Left            =   120
  121.       TabIndex        =   11
  122.       Top             =   1440
  123.       Width           =   1695
  124.    End
  125.    Begin VB.Label Label3 
  126.       BackStyle       =   0  'Transparent
  127.       Caption         =   "Last Synchronization"
  128.       ForeColor       =   &H00000000&
  129.       Height          =   255
  130.       Left            =   120
  131.       TabIndex        =   10
  132.       Top             =   1875
  133.       Width           =   1695
  134.    End
  135.    Begin VB.Label Label2 
  136.       Caption         =   "Time server"
  137.       ForeColor       =   &H00000000&
  138.       Height          =   255
  139.       Left            =   120
  140.       TabIndex        =   9
  141.       Top             =   2640
  142.       Width           =   2415
  143.    End
  144.    Begin VB.Label lblStatus 
  145.       Appearance      =   0  'Flat
  146.       BackColor       =   &H00FFC0C0&
  147.       BackStyle       =   0  'Transparent
  148.       Caption         =   "Press the Synchronize Button to adjust the Computer System Time."
  149.       ForeColor       =   &H00000000&
  150.       Height          =   255
  151.       Left            =   120
  152.       TabIndex        =   7
  153.       Top             =   2280
  154.       Width           =   5055
  155.    End
  156.    Begin VB.Label lblDateTime 
  157.       BackStyle       =   0  'Transparent
  158.       Caption         =   "None"
  159.       ForeColor       =   &H00000000&
  160.       Height          =   255
  161.       Left            =   1800
  162.       TabIndex        =   6
  163.       Top             =   1875
  164.       Width           =   3615
  165.    End
  166.    Begin VB.Label lblPcTime 
  167.       BackStyle       =   0  'Transparent
  168.       Caption         =   "-"
  169.       ForeColor       =   &H00000000&
  170.       Height          =   255
  171.       Left            =   1800
  172.       TabIndex        =   5
  173.       Top             =   1440
  174.       Width           =   3615
  175.    End
  176. End
  177. Attribute VB_Name = "frmMain"
  178. Attribute VB_GlobalNameSpace = False
  179. Attribute VB_Creatable = False
  180. Attribute VB_PredeclaredId = True
  181. Attribute VB_Exposed = False
  182. Option Explicit
  183.  
  184. Private Sub cboServers_Click()
  185. TIME_SERVER = Me.cboServers.Text
  186. ServerIndex = Me.cboServers.ListIndex
  187. End Sub
  188.  
  189. Private Sub cmdClose_Click()
  190. Unload Me
  191. End Sub
  192.  
  193. Private Sub Form_Activate()
  194.  
  195. If BatchMode = True Then Call cmdSynchTime_Click
  196.  
  197. End Sub
  198.  
  199. Private Sub Form_Load()
  200.  
  201. Call LoadServers
  202.  
  203. TIME_SERVER = Me.cboServers.Text
  204. Me.lblDateTime = GetSetting(App.EXEName, "Timeserver", "Last", "None")
  205.  
  206. 'If BatchMode = True Then Call cmdSynchTime_Click
  207.  
  208. End Sub
  209.  
  210. Private Sub cmdSynchTime_Click()
  211. Dim Echeck As Boolean
  212.     Dim oInetTime As cInetTime
  213.     Set oInetTime = New cInetTime
  214.     
  215.     Me.Timer1.Enabled = False
  216.     Me.imgWarn.Visible = False
  217.     lblStatus.Caption = "Connecting to Server..."
  218.     cmdSynchTime.Enabled = False
  219.  
  220.     With oInetTime
  221.         .TimeServer = TIME_SERVER
  222.         .SetTime
  223.         If .ErrorCheck = True Then
  224.             Echeck = True
  225.             lblStatus.Caption = "          No response from Time Server."
  226.             Me.imgWarn.Visible = True
  227.             
  228.         Else
  229.             lblStatus.Caption = "Adjusted " & .AdjustedSecs & " Sec"
  230.             lblDateTime.Caption = ":  " & Format(.ReturnedDate, "dddd dd mmm yyyy  hh:mm:ss")
  231.             lblDateTime.Visible = True
  232.             Echeck = False
  233.             Me.imgWarn.Visible = False
  234.             
  235.         End If
  236.         
  237.     End With
  238.     
  239.     cmdSynchTime.Enabled = True
  240.     cmdSynchTime.SetFocus
  241.     
  242.     Set oInetTime = Nothing
  243.     
  244.     If BatchMode = True And Echeck = False Then Unload Me
  245.     
  246.     BatchMode = False
  247.     Me.Timer1.Enabled = True
  248. End Sub
  249.  
  250. Private Sub Form_Unload(Cancel As Integer)
  251.  
  252.     SaveSetting App.EXEName, "Timeserver", "Name", TIME_SERVER
  253.     SaveSetting App.EXEName, "Timeserver", "Index", Trim(Str(ServerIndex))
  254.     SaveSetting App.EXEName, "Timeserver", "Last", Me.lblDateTime.Caption
  255.     End
  256.  
  257. End Sub
  258.  
  259. Private Sub Timer1_Timer()
  260. Me.lblPcTime.Caption = ":  " & Format(Now, "dddd dd mmm yyyy  hh:mm:ss")
  261. End Sub
  262.  
  263. Private Sub LoadServers()
  264. Dim InFile
  265. Dim ServerName As String
  266. Dim remPos As Integer
  267.  
  268. InFile = FreeFile
  269.  
  270. On Error GoTo LoadDefaults
  271. Open App.Path & "\SERVERS.txt" For Input As InFile
  272.     While Not EOF(InFile)
  273.         'get next line
  274.         Line Input #InFile, ServerName
  275.         If Left(ServerName, 1) <> ";" And Trim(ServerName) <> "" Then 'skip remarques and empty's
  276.             remPos = InStr(1, ServerName, ";")
  277.             If remPos <> 0 Then ServerName = Trim(Left(ServerName, remPos - 1))
  278.             cboServers.AddItem ServerName
  279.             End If
  280.     Wend
  281. Close InFile
  282. If ServerIndex > cboServers.ListCount - 1 Then ServerIndex = 0
  283. cboServers.ListIndex = ServerIndex
  284. Exit Sub
  285.  
  286. LoadDefaults:
  287. Close InFile
  288.  
  289.     With cboServers
  290.         .AddItem "ntps1-0.cs.tu-berlin.de"
  291.         .AddItem "ntps1-0.uni-erlangen.de"
  292.         .AddItem "ntps1-1.uni-erlangen.de"
  293.         .AddItem "ntps1-2.uni-erlangen.de"
  294.         .AddItem "ptbtime1.ptb.de"
  295.         .AddItem "ptbtime2.ptb.de"
  296.         .AddItem "tick.usno.navy.mil"
  297.         .AddItem "timex.cs.columbia.edu"
  298.         .AddItem "nist1.datum.com"
  299.         .AddItem "time.ien.it"
  300.         .AddItem "swisstime.ethz.ch"
  301.         .AddItem "ntp.lth.se"
  302.         .AddItem "Rolex.PeachNet.edu"
  303.         If ServerIndex > .ListCount - 1 Then ServerIndex = 0
  304.         .ListIndex = ServerIndex
  305.     End With
  306.  
  307. End Sub
  308.  
  309.